Language/OS - Multiplatform Resource Library

home *** CD-ROM | disk | FTP | other *** search

/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / SCHEME.AS0 < prev next >

Wrap

Text File | 1993-11-08 | 29.5 KB | 1,015 lines

;* SCHEME.ASH %PUSHLCTL %NOLIST ;************************************************************************ ;* * ;* PC Scheme/Geneva 4.00 Borland TASM code * ;* * ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT * ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva * ;* * ;*----------------------------------------------------------------------* ;* * ;* All scheme constants you dreamed of * ;* * ;*----------------------------------------------------------------------* ;* * ;* Created by: John Jensen Date: 1985 * ;* Revision history: * ;* - 10 Feb 87: Modified Page 5 special symbols to reflect #T * ;* per the R^3 Report. (tc) * ;* - 18 Jun 92: Renaissance (Borland Compilers, ...) * ;* * ;* ``In nomine omnipotentii dei'' * ;************************************************************************ P8086 P8087 EMUL ; Signal a debugging point when vm_debug enabled. MACRO action what LOCAL @@text, @@adr, @@skip IFDEF VMDEBUG Dataseg @@text db '&what', 0 @@adr dw OFFSET @@text Codeseg cmp [vm_debug], 0 jz @@skip push ax bx cx dx es pushf call printf C, [@@adr] popf pop es dx cx bx ax @@skip: ENDIF ENDM ; Adjust page number prior to store into pointer MACRO adjpage reg sal reg, 1 ENDM ; Convert page number from physical representation to logical page MACRO corpage reg shr reg, 1 ENDM ; Push the page number and displacement components of a Scheme ; pointer onto the runtime stack (parameter passing mechanism) MACRO pushptr addr push [(POINTER addr).disp] mov al, [(POINTER addr).page] and ax, PAGEMASK push ax ENDM ; Pop the page number and displacement components of a Scheme ; pointer from the runtime stack and restore a memory location ; (parameter return mechanism) MACRO popptr addr pop ax mov [(POINTER addr).page], al pop [(POINTER addr).disp] ENDM ; Save the registers in the macro's argument (a list) in the local ; stack in the variables "save_xx", where "xx" is the register name. MACRO save regs IRP rr, <regs> mov [save_&&rr], rr ENDM ENDM ; Restore the registers in the macro's argument (a list) from the local ; stack in the variables "save_xx", where "xx" is the register name. MACRO restore regs IRP rr, <regs> mov rr, [save_&&rr] ENDM ENDM MACRO get1op seges lodsb ENDM MACRO get2op seges lodsw ENDM BELL EQU 07h ; Standard ascii constants BACKSPACE EQU 08h TAB EQU 09h LF EQU 0ah CR EQU 0dh CTRL_Z EQU 1ah ESCAPE EQU 1bh SPACE EQU 20h DEL EQU 7fh ; ctrl-backspaceh ENTER_KEY EQU 0d00h ; Extended key codes HOME_KEY EQU 4700h UP_KEY EQU 4800h LEFT_KEY EQU 4b00h RIGHT_KEY EQU 4d00h END_KEY EQU 4f00h DOWN_KEY EQU 5000h INSERT_KEY EQU 5200h DELETE_KEY EQU 5300h CTRL_LEFT_KEY EQU 7300h CTRL_RIGHT_KEY EQU 7400h CTRL_END_KEY EQU 7500h CTRL_HOME_KEY EQU 7700h CTRL_DEL_KEY EQU 9300h ; exists since DOS 5.0 (or 4.0 ?) MSDOS = 21h ; Most used interrupts IBM_CRT = 10h EMMINT = 67h ; The following equates set the limits on the virtual memory (paging) system: MIN_PAGESIZE = 0C00H ; Minimum page size for conventional memory MAXEMS = NUMPAGES - PREALLOC - 8 ; guarantee we use some conventional mem. EMSSIZE = 4000h NUMPAGES = 128 ; Total number of pages DEDPAGES = 8 ; Number of dedicated pages PREALLOC = DEDPAGES+1 ; Pre-allocated pages HT_SIZE = 211 ; The oblist's hash table size STKSIZE = 900 ; Length of Scheme's internal stack (bytes) NUM_REGS = 64 ; Number of general regs in the Scheme VM SPECIALCHARS = 8 ; special chars: NEWLINE, RUBOUT, ... GC_BIT = 1 shl 0 ; bit #0 is used in all structures for GC ; Page attribute bits ATOM = 08000H ; 1 = Atomic data LISTCELL = 04000H ; 1 = List (cons) cells FIXNUMS = 02000H ; 1 = 16-bit integer data FLONUMS = 01000H ; 1 = 32-bit floating point data BIGNUMS = 00800H ; 1 = big integer values SYMBOLS = 00400H ; 1 = symbols STRINGS = 00200H ; 1 = strings VECTORS = 00100H ; 1 = vector (array) storage NOMEMORY = 00080H ; 1 = no memory allocated READONLY = 00040H ; 1 = memory is read only (constant) CONTINU = 00020H ; 1 = continuation object CLOSURE = 00010H ; 1 = closure object I86CODE = 00008H ; 1 = inline 8086 code PORTS = 00004H ; 1 = I/O ports CODE = 00002H ; 1 = code block CHARS = 00001H ; 1 = characters NUMBERS = FIXNUMS+FLONUMS+BIGNUMS ; number (fixnums, flonums, bignums) ; Data type equates (classes of data objects) NUMTYPES = 15 ; Number of data types LISTTYPE = 0 FIXTYPE = 2 FLOTYPE = 4 BIGTYPE = 6 SYMBTYPE = 8 STRTYPE = 10 VECTTYPE = 12 CONTTYPE = 14 CLOSTYPE = 16 FREETYPE = 18 CODETYPE = 20 I86TYPE = 22 PORTTYPE = 24 CHARTYPE = 26 ENVTYPE = 28 ; Special pre-allocated pages SPECCHAR = 1 SPECFREE = 2 SPECFIX = 3 SPECFLO = 4 SPECSYM = 5 SPECPOR = 6 SPECCODE = 7 ; Predefined constants T_PAGE = SPECSYM ; symbol 't' (representing true) T_DISP = 0000H UN_PAGE = SPECSYM ; symbol '#!unassigned' (unbound variable) UN_DISP = 0009H NTN_PAGE = SPECSYM ; symbol '#!not-a-number' NTN_DISP = 001CH DIV0_PAGE = SPECSYM ; symbol for divide by 0 DIV0_DISP = 001CH EOF_PAGE = SPECSYM ; symbol for '#!EOF EOF_DISP = 00031H NPR_PAGE = SPECSYM ; symbol for '#!unprintable' NPR_DISP = 003DH NIL_PAGE = 0 ; symbol 'nil' (representing itself) NIL_DISP = 0 ; End of linked list indicator END_LIST = 07FFFH ; Numeric operator sub-opcodes ADD_OP = 0 ; add SUB_OP = 1 ; subtract MUL_OP = 2 ; multiply DIV_OP = 3 ; divide REM_OP = 4 ; remainder AND_OP = 5 ; bitwise-and OR_OP = 6 ; bitwise-or MINUS_OP = 7 ; minus EQ_OP = 8 ; = (equal comparison) NE_OP = 9 ; <> (not equal comparison) LT_OP = 10 ; < (less than comparison) GT_OP = 11 ; > (greater than comparison) LE_OP = 12 ; <= (less than or equal comparison) GE_OP = 13 ; >= (greater than or equal comparison) ABS_OP = 14 ; absolute value QUOT_OP = 15 ; quotient (integers) ZERO_OP = 21 ; zero? POS_OP = 22 ; positive? NEG_OP = 23 ; negative? XOR_OP = 24 ; bitwise-xor DIVIDE_OP = 25 ; divide (integers) MOD_OP = 26 ; modulo RV_PROCEED = 0 RV_HALT = 1 RV_SDEBUG = 2 RV_CLOBBERED = 3 ; Numeric Error Codes REF_GLOBAL_ERROR = 1 ; reference of unbound global variable SET_GLOBAL_ERROR = 2 ; SET! error-- global not defined REF_LEXICAL_ERROR = 3 ; reference of unbound lexical variable SET_LEXICAL_ERROR = 4 ; SET! error-- lexical variable not defined REF_FLUID_ERROR = 5 ; reference of unbound fluid variable SET_FLUID_ERROR = 6 ; SET-FLUID! error-- fluid not bound VECTOR_OFFSET_ERROR = 7 ; vector index out of range STRING_OFFSET_ERROR = 8 ; string index out of range SUBSTRING_RANGE_ERROR = 9 ; invalid substring range INVALID_OPERAND_ERROR = 10 ; Invalid operand to VM instruction SHIFT_BREAK_CONDITION = 11 ; SHFT-BRK key was depressed by user NON_PROCEDURE_ERROR = 12 ; Attempted to call non-procedural object TIMEOUT_CONDITION = 13 ; Timer interrupt or Mouse Event WINDOW_FAULT_CONDITION = 14 ; Attempt to do I/O to a de-exposed window FLONUM_OVERFLOW_ERROR = 15 ; Flonum Over/Under-flow ZERO_DIVIDE_ERROR = 16 ; Division by zero NUMERIC_OPERAND_ERROR = 17 ; non-numeric operand APPLY_ARG_LIMIT_ERROR = 18 ; too many arguments for APPLY to handle VECTOR_SIZE_LIMIT_ERROR = 19 ; attempt to allocate vector which is too big STRING_SIZE_LIMIT_ERROR = 20 ; attempt to allocate string which is too big IO_ERRORS_START = 21 ; Errors between 21 and 84 are DOS I/O errors DOS_FATAL_ERROR = 21 ; Generic fatal I/O error EXTEND_START_ERROR_CODE = 1 ; Extended error codes from INT 59h EXTEND_END_ERROR_CODE = 88 DISK_FULL_ERROR = 200 ; Our own home-grown error codes LAST_ERROR = 200 ; Future errors should start here ; Here follow the most useful typedefs, also available in C (lb) STRUC REG disp DW ? LABEL bpage BYTE page DW ? ENDS REG STRUC POINTER page DB ? disp DW ? ENDS POINTER STRUC FIXNUM tag DB SPECFIX*2 val DW ? ENDS FIXNUM ; Generic object (inherited) STRUC ANYDEF UNION tag DB ? gc DB ? ENDS len DW ? data POINTER <> ENDS ANYDEF ; Free cell (!) STRUC FREEDEF UNION tag DB FREETYPE gc DB ? ENDS len DW ? ENDS FREEDEF ; Free linked list cell STRUC FREELISTDEF tag DB SPECFREE*2 next DW ? ; pointer to next free cell in page ENDS FREELISTDEF ; List Cell ; +-------------v-+-------------------------------+ ; | car page # |g| car displacement | ; +-------------^-+-------------------------------+ ; | cdr page # |0| cdr displacement | ; +---------------+-------------------------------+ ; where g = used during garbage collection STRUC LISTDEF UNION car POINTER <> ptr POINTER <> gc DB ? ENDS cdr POINTER <> ENDS LISTDEF ; Bignum ; +-------------v-+-------------------------------+ ; | BIGTYPE |g| length in bytes | ; +-------------^-+-------------------------------+ ; | sign | least significant word | ; +---------------+-------------------------------- ; : : ; +-------------------------------+ ; | most significant word | ; +-------------------------------+ ; where g = used during garbage collection STRUC BIGDATA len DW ? ; length of entire data structure in bytes sign DB ? ; sign of the bignum lsw DW ? ; data bits, with LSBs appearing first msw DW ? ; second word of significant bits ENDS BIGDATA STRUC BIGDEF UNION tag DB BIGTYPE ; tag = bignum gc DB ? ENDS data BIGDATA ? ENDS BIGDEF ; special structure to occupy a vacant slot in a FLONUM page STRUC FREEFLODEF tag DB FREETYPE next DW ? ; pointer to next free cell in page ENDS FREEFLODEF ; Flonum ; +-------------v-+---+---+---+---+---+---+---+---+ ; | FLOTYPE | | 64 bit IEEE floating point | ; +-------------^-+---+---+---+---+---+---+---+---+ ; where g = used during garbage collection STRUC FLODEF UNION tag DB FLOTYPE ; tag = flonum gc DB ? ENDS UNION data DQ ? ptr POINTER <> ENDS ENDS FLODEF ; Vector (Array) ; +-------------v-+-------------------------------+ ; | VECTTYPE |g| length in bytes | ; +-------------^-+-------------------------------+ ; : data #i pointer : ; ------------------------------------------------+ ; where g = used during garbage collection STRUC VECDEF UNION tag DB VECTTYPE gc DB ? ENDS len DW ? LABEL data POINTER ENDS VECDEF ; Symbol ; +-------------v-+-------------------------------+ ; | SYMBTYPE |g| length in bytes | ; +-------------^-+-------------------------------+ ; | link pointer | ; +-+-------------+---------------v---------------+ ; | hash value : characters : ; +---------------+---------------+ ; where g = used during garbage collection STRUC SYMDEF UNION tag DB SYMBTYPE ; tag = symbol gc DB ? ENDS len DW ? ; length of symbol structure in bytes link POINTER <> hashkey DB ? ; hash key LABEL buffer BYTE ; character(s) in symbol ENDS SYMDEF ; String ; +-------------v-+-------------------------------+ ; | STRTYPE |g| length in bytes | ; +-------------^-+-------------------------------+ ; : characters : ; +---------------+ ; where g = used during garbage collection STRUC STRDEF UNION tag DB STRTYPE ; tag = string gc DB ? ENDS len DW ? ; length of string structure in bytes LABEL buffer BYTE ; character(s) in string ENDS STRDEF MACRO sstrlen dest, pntr, ohead LOCAL @@bigstring, @@allstrings mov dest, [(STRDEF pntr).len] or dest, dest jge @@bigstring IFIDN <ohead>, <OVERHEAD> add dest, OFFSET (TYPE STRDEF).buffer + SIZE POINTER @@bigstring: ELSE add dest, SIZE POINTER jmp @@allstrings @@bigstring: sub dest, OFFSET (TYPE STRDEF).buffer @@allstrings: ENDIF ENDM ; Closure ; +-------------v-+-------------------------------+ ; | CLOSTYPE |g| length in bytes | ; +-------------^-+-------------------------------+ ; | information operand pointer | ; +---------------+-------------------------------+ ; | heap environment pointer | ; +---------------+-------------------------------+ ; | code block pointer | ; +---------------+-------------------------------+ ; | SPECFIX*2 | Entry Point Displacement | ; +---------------+-------------------------------+ ; | SPECFIX*2 | Number of Arguments | ; +---------------+-------------------------------+ ; where g = used during garbage collection STRUC CLOSDEF UNION tag DB CLOSTYPE ; tag = closure gc DB ? ENDS len DW ? ; length of closure object in bytes info POINTER <> ; information operand heap POINTER <> ; heap environment pointer codeblk POINTER <> ; code base entry FIXNUM <> ; entry point tag = immediate args FIXNUM <> ; number of arguments tag = immediate LABEL debug BYTE ; optional debugging information? ENDS CLOSDEF ; Continuation ; +-------------v-+-------------------------------+ ; | CONTTYPE |g| length in bytes | ; +-------------^-+-------------------------------+ ; | SPECFIX*2 | stack base of continuation | ; +---------------+-------------------------------+ ; | return address code base pointer |\ ; +---------------+-------------------------------+ | return address ; | SPECFIX*2 | return address displacement |/ ; +---------------+-------------------------------+ ; | SPECFIX*2 | caller's dynamic link (FP) | ; +---------------+-------------------------------+ ; | fluid environment pointer (fnv_reg) | ; +---------------+-------------------------------+ ; | previous stack segment (continuation) pointer | ; +---------------+-------------------------------+ ; | global environment pointer (gnv_reg) | ; +---------------+-------------------------------+ ; : :< - BASE ; : [contents of stack at call/cc] : ; : :< - topofstack ; +-----------------------------------------------+ ; where g = used during garbage collection STRUC CONTDEF UNION tag DB CONTTYPE ; tag = continuation gc DB ? ENDS len DW ? ; length of continuation structure in bytes base FIXNUM <> codeblk POINTER <> ; return address code base pointer retaddr FIXNUM <> ; return address displacement dynlink FIXNUM <> ; caller's dynamic link fluid POINTER <> ; fluid environment pointer stk POINTER <> ; previous stack segment pointer globenv POINTER <> ; global environment pointer LABEL data BYTE ; contents of stack at call/cc ENDS CONTDEF ; Code Block ; +-------------v-+-------------------------------+ ; | CODETYPE |g| length in bytes | ; +-------------^-+-------------------------------+ ; | SPECFIX*2 | entry offset |-\ ; +---------------+-------------------------------+ | ; : pointer to constant #i : | ; +---------------+---------------+---------------+ | ;/----->: code : | ;| +---------------+ | ;\--------------------------------------------------------/ ; where g = used during garbage collection STRUC CODEDEF UNION tag DB CODETYPE ; tag = code block gc DB ? ENDS len DW ? ; length of code block in bytes entry FIXNUM <> ; entry offset tag = fixnum consts POINTER <> ; code block constants area ENDS CODEDEF ; Inline code block ; +-------------v-+-------------------------------+ ; | I86TYPE |g| length in bytes + ; +-------------^-+-------------------------------+ ; : machine code : ; +---------------+ ; where g = used during garbage collection STRUC I86DEF UNION tag DB I86TYPE gc DB ? ENDS len DW ? LABEL data BYTE ENDS I86DEF ; Environment Data Object ; +-------------v-+-------------------------------+ ; | ENVTYPE |g| length in bytes | ; +-------------^-+-------------------------------+ ; | parent pointer | ; +---------------+-------------------------------+ ; | list of symbols (linked through cdr field) | ; +---------------+-------------------------------+ ; | list of values (linked through car field) | ; +---------------+-------------------------------+ ; where g = used during garbage collection STRUC ENVDEF UNION tag DB ENVTYPE ; tag = environment gc DB ? ENDS len DW ? ; length in bytes parent POINTER <> names POINTER <> ; list of names values POINTER <> ; list of values ENDS ENVDEF ; Port ; +-------------v-+-------------------------------+ ; | PORTTYPE |g| length in bytes | ; +-------------^-+-------------------------------+ ; | source pointer | ; +---------------+---------------+---------------+---------------+ ; | port flags | handle | ; +---------------+---------------+---------------+---------------+ ; | cursor line | cursor column | ; +---------------+---------------+---------------+---------------+ ; | upper left line | upper left column | ; +---------------+---------------+---------------+---------------+ ; | number of lines | number of columns | ; +---------------+---------------+---------------+---------------+ ; | border attributes | text attributes | ; +---------------+---------------+---------------+---------------+ ; | window flags | buffer position | ; +---------------+---------------+---------------+---------------+ ; | buffer end : i/o buffer : ; +---------------+---------------+---------------+ ; where g = used during garbage collection ; ; 10 9 8 7 6 5 4 3 2 1 0 ; +-^-^-^-v-v---v---v---+ ; port flags: |l|t|w|f|m|typ|wrm|rdm| ; +-^-^-+-^-^---^---^---+ ; ; rdm (read mode) : 11 read exclusive ; 10 read shared ; 01 read ignored (return #eof) ; 00 read closed ; wrm (write mode) : 11 write exclusive ; 10 write shared ; 01 write ignored ; 00 write closed ; typ (port type) : 11 file (name at source ptr) ; 10 string (source at source ptr) ; 01 software (closure at source ptr) ; 00 window (label at source ptr) ; m (port mode) : 1 binary ; 0 text ; f (flush state) : 1 port was flushed (buffer unchanged) ; 0 port not flushed (buffer modified) ; w (wrap mode): 1 wrap ; 0 clip ; t (transcript mode): 1 transcript on ; 0 transcript off ; l (locking mode): 1 auto-lock on ; 0 auto-lock off ; BUFFSIZE = 100h STRUC PORTDEF UNION tag DB PORTTYPE ; tag = port gc DB ? ENDS len DW ? ; length of port structure in bytes ptr POINTER <> pflags DW ? ; port flags handle DW ? ; file's handle curline DW ? ; cursor line number curcol DW ? ; cursor column number LABEL chunk WORD ; chunk (buffer #) ulline DW ? ; upper left hand corner's line number ulcol DW ? ; upper left hand corner's column number nlines DW ? ; number of lines ncols DW ? ; number of columns/line length border DW ? ; window's border attributes text DW ? ; window's text attributes flags DW ? ; window flags bufpos DW ? ; buffer position (offset) bufend DW ? ; end of buffer offset buffer DB BUFFSIZE DUP (?) ; input/output buffer next POINTER <> ENDS PORTDEF W_WRAP = 00000001b ; kill these W_TRANS = 00000010b ; kill these PORT_OPEN = 0000000000001111b READ_MODE = 0000000000000011b READ_OPEN = 0000000000000010b WRITE_MODE = 0000000000001100b WRITE_OPEN = 0000000000001000b PORT_TYPE = 0000000000110000b PORT_SHARED = 0000000000100000b PORT_BINARY = 0000000001000000b PORT_FLUSHED = 0000000010000000b PORT_WRAP = 0000000100000000b PORT_TRANSCRIPT = 0000001000000000b PORT_LOCKED = 0000010000000000b READ_EXCLUSIVE = 0000000000000011b READ_SHARED = 0000000000000010b READ_IGNORED = 0000000000000001b READ_CLOSED = 0000000000000000b WRITE_EXCLUSIVE = 0000000000001100b WRITE_SHARED = 0000000000001000b WRITE_IGNORED = 0000000000000100b WRITE_CLOSED = 0000000000000000b TYPE_FILE = 0000000000110000b TYPE_STRING = 0000000000100000b TYPE_SOFTWARE = 0000000000010000b TYPE_WINDOW = 0000000000000000b IN_PAGE = SPECPOR ; standard input port IN_DISP = 0 OUT_PAGE = SPECPOR ; standard output port OUT_DISP = 0 WHO_PAGE = SPECPOR ; "who-line" WHO_DISP = SIZE PORTDEF ; Stack Frame ; ; +------------+--------------------------+ ; Stack base--->| stack for prev dynamic levels : ; +------------+--------------------------+ ; Frame pointer>| code base pointer | ; +------------+--------------------------+ ; | return address | ; +------------+--------------------------+ ; | dynamic link | caller's FP ; +------------+--------------------------+ ; | environment | current environment ; +------------+--------------------------+ ; | static link | lexical parent's FP ; +------------+--------------------------+ ; | closure ptr | pointer to routine's closure object ; +------------+--------------------------+ (or nil, if an open call) ; : local variable pointer : ; +------------+--------------------------+ ; top of stack->| last local variable | ; +------------+--------------------------+ STRUC STKFDEF codeblk POINTER <> ; code base pointer retaddr POINTER < SPECFIX*2 > ; return address dynlink POINTER < SPECFIX*2 > ; dynamic link heap POINTER <> ; heap environment statlink POINTER < SPECFIX*2 > ; lex parent's static link closure POINTER <> ; closure pointer LABEL data POINTER ; start of local variable allocation area ENDS STKFDEF ;************************************************************************ ;* Here are the global declarations * ;************************************************************************ GLOBAL C clock: FAR GLOBAL C close: FAR GLOBAL C exit: FAR GLOBAL C free: FAR GLOBAL C heapcheck: FAR GLOBAL C malloc: FAR GLOBAL C realloc: FAR GLOBAL C printf: FAR GLOBAL C sprintf: FAR GLOBAL C strlen: FAR GLOBAL @REG@relocate$qv: FAR GLOBAL @REG@check$qv: FAR GLOBAL @REG@cleanup$qp3REGt1: FAR GLOBAL alloc_err: NEAR GLOBAL appendb: NEAR GLOBAL apply: NEAR GLOBAL apply_tr: NEAR GLOBAL assoc: NEAR GLOBAL assq: NEAR GLOBAL assv: NEAR GLOBAL bind_fl: NEAR GLOBAL call_cc: NEAR GLOBAL call_clo: NEAR GLOBAL call_ctr: NEAR GLOBAL call_lcl: NEAR GLOBAL call_ltr: NEAR GLOBAL ch_down: NEAR GLOBAL ch_eq_ci: NEAR GLOBAL ch_eq_p: NEAR GLOBAL ch_lt_ci: NEAR GLOBAL ch_lt_p: NEAR GLOBAL ch_up: NEAR GLOBAL clcc_c: NEAR GLOBAL clcc_ctr: NEAR GLOBAL cl_cctr: NEAR GLOBAL cr_close: NEAR GLOBAL debug_op: NEAR GLOBAL define: NEAR GLOBAL def_env: NEAR GLOBAL drop_env: NEAR GLOBAL env_lu: NEAR GLOBAL env_p: NEAR GLOBAL env_par: NEAR GLOBAL execute: NEAR GLOBAL exit_suspend: NEAR GLOBAL fix_big: NEAR GLOBAL fluid_p: NEAR GLOBAL get_num: NEAR GLOBAL get_wind: NEAR GLOBAL graph_attr: NEAR GLOBAL hash_env: NEAR GLOBAL ld_caaar: NEAR GLOBAL ld_caadr: NEAR GLOBAL ld_caar: NEAR GLOBAL ld_cadar: NEAR GLOBAL ld_caddd: NEAR GLOBAL ld_caddr: NEAR GLOBAL ld_cadr: NEAR GLOBAL ld_car: NEAR GLOBAL ld_car1: NEAR GLOBAL ld_cdaar: NEAR GLOBAL ld_cdadr: NEAR GLOBAL ld_cdar: NEAR GLOBAL ld_cddar: NEAR GLOBAL ld_cdddr: NEAR GLOBAL ld_cddr: NEAR GLOBAL ld_cdr: NEAR GLOBAL ld_cdr1: NEAR GLOBAL ld_env: NEAR GLOBAL ld_fluid: NEAR GLOBAL ld_fl_r: NEAR GLOBAL ld_globl: NEAR GLOBAL ld_globr: NEAR GLOBAL ld_lex: NEAR GLOBAL ld_local: NEAR GLOBAL list2: NEAR GLOBAL loadems: FAR GLOBAL lookup: FAR GLOBAL l_tail: NEAR GLOBAL make_str: NEAR GLOBAL make_win: NEAR GLOBAL member: NEAR GLOBAL memq: NEAR GLOBAL memv: NEAR GLOBAL mk_env: NEAR GLOBAL next: NEAR GLOBAL next_pc: NEAR GLOBAL not_yet: NEAR GLOBAL obj_hash: NEAR GLOBAL obj_unhs: NEAR GLOBAL prt_len: NEAR GLOBAL push_env: NEAR GLOBAL rd_ch_rd: NEAR GLOBAL read_cha: NEAR GLOBAL restscr: FAR GLOBAL rest_win: NEAR GLOBAL ret_num: NEAR GLOBAL reverseb: NEAR GLOBAL save_win: NEAR GLOBAL sch_err: NEAR GLOBAL sdrop: NEAR GLOBAL set_car: NEAR GLOBAL set_cdr: NEAR GLOBAL set_gnv: NEAR GLOBAL shft_brk: FAR GLOBAL spnewlin: NEAR GLOBAL spop: NEAR GLOBAL spprinc: NEAR GLOBAL spprint: NEAR GLOBAL spprin1: NEAR GLOBAL spush: NEAR GLOBAL src_err: NEAR GLOBAL srd_atom: NEAR GLOBAL srd_line: NEAR GLOBAL str_apnd: FAR GLOBAL str_fill: NEAR GLOBAL st_env: NEAR GLOBAL st_fluid: NEAR GLOBAL st_globl: NEAR GLOBAL st_lex: NEAR GLOBAL st_local: NEAR GLOBAL st_ref: NEAR GLOBAL st_set: NEAR GLOBAL s_cons: NEAR GLOBAL s_disply: NEAR GLOBAL s_exit: NEAR GLOBAL s_list: NEAR GLOBAL take_fil: NEAR GLOBAL timeout: NEAR GLOBAL trns_chg: NEAR GLOBAL try_big: NEAR GLOBAL unbind_f: NEAR GLOBAL vec_allo: NEAR GLOBAL vec_fill: NEAR GLOBAL vec_size: NEAR ;************************************************************************ ;* MMU global data * ;************************************************************************ GLOBAL defpagesize: WORD GLOBAL pagetable: WORD:NUMPAGES GLOBAL C nextpage: WORD ; Next unused page number GLOBAL C nextpara: WORD ; Next available paragraph number GLOBAL C lastpage: WORD ; Last unused page number GLOBAL C attrib: WORD:NUMPAGES ; Page Attribute Table GLOBAL C nextcell: WORD:NUMPAGES ; Next available location table GLOBAL C pagelink: WORD:NUMPAGES ; Page link table GLOBAL C ptype: BYTE:NUMPAGES ; Page type table GLOBAL C psize: WORD:NUMPAGES ; Page size table GLOBAL C pageattr: WORD:NUMTYPES GLOBAL C pagelist: WORD:NUMTYPES GLOBAL C listpage: WORD ; [0] Page number for list cell allocation GLOBAL C fixpage: WORD ; [1] Page number for fixnum allocation GLOBAL C flopage: WORD ; [2] Page number for flonum allocation GLOBAL C bigpage: WORD ; [3] Page number for bignum allocation GLOBAL C sympage: WORD ; [4] Page number for symbol allocation GLOBAL C stpage: WORD ; [5] Page number for string allocation GLOBAL C vectpage: WORD ; [6] Page number for vector allocation GLOBAL C contpage: WORD ; [7] Page number for continuation allocation GLOBAL C clospage: WORD ; [8] Page number for closure allocation GLOBAL C freepage: WORD ; [9] Page number for free pages list GLOBAL C codepage: WORD ; [10] Page number for code page allocation GLOBAL C i86page: WORD ; [11] Page number for inline code allocation GLOBAL C portpage: WORD ; [12] Page number for port cell allocation GLOBAL C chapage: WORD ; [13] Page number for characters GLOBAL C envpage: WORD ; [14] Page number for environments ;************************************************************************ ;* Hashing & propertizing * ;************************************************************************ GLOBAL C hash_page: BYTE:HT_SIZE GLOBAL C hash_disp: WORD:HT_SIZE ; oblist's hash table GLOBAL C obj_hlist: POINTER ; object hash table GLOBAL C prop_page: BYTE:HT_SIZE GLOBAL C prop_disp: WORD:HT_SIZE ; property list hash table ;************************************************************************ ;* Registers * ;************************************************************************ GLOBAL C cb_reg: REG GLOBAL C console_reg: REG GLOBAL C fnv_reg: REG GLOBAL C fnv_save: REG GLOBAL C gnv_reg: REG GLOBAL C nil_reg: REG GLOBAL C prev_reg: REG GLOBAL C macro_reg: REG GLOBAL C quote_reg: REG GLOBAL C reg0: REG GLOBAL C reg1: REG GLOBAL C regs: REG:NUM_REGS GLOBAL C stl_save: REG GLOBAL C tm2_reg: REG GLOBAL C tm2_adr: WORD GLOBAL C tmp_reg: REG GLOBAL C tmp_adr: WORD GLOBAL C trns_reg: REG GLOBAL C macro_reg: REG GLOBAL C port_reg: REG GLOBAL C nextport_reg: REG:4 GLOBAL C s_stack: STKFDEF ; The Scheme runtime stack ;************************************************************************ ;* all global data * ;************************************************************************ GLOBAL C base: WORD GLOBAL C ccount: WORD GLOBAL C curcol: WORD GLOBAL C curline: WORD GLOBAL curs_sav: WORD GLOBAL cur_off: WORD GLOBAL C decpoint: BYTE GLOBAL C pflags: WORD GLOBAL emsbias: BYTE GLOBAL emshandle: WORD GLOBAL C emspages: BYTE GLOBAL C err_ent: WORD ; Scheme debugger entry point offset GLOBAL firstparagraph: WORD GLOBAL first_dos: WORD GLOBAL C fp_save: WORD GLOBAL C frameptr: WORD GLOBAL C handlee: WORD GLOBAL C hicases: BYTE GLOBAL C history: BYTE GLOBAL C histpos: WORD GLOBAL C histend: WORD GLOBAL C icount: DWORD:256 GLOBAL C index: WORD GLOBAL C insert_m: WORD GLOBAL C locases: BYTE GLOBAL mouse_use: WORD GLOBAL C ncols: WORD GLOBAL C nlines: WORD GLOBAL C paragraphnum: WORD GLOBAL C pcsksenv: WORD ; char * GLOBAL C pcsrsenv: WORD ; char * GLOBAL C prn_handle: WORD GLOBAL C rst_ent: WORD ; Scheme-reset state variables GLOBAL C show: BYTE GLOBAL C spchars: WORD GLOBAL C stk_in: DWORD GLOBAL C stk_out: DWORD GLOBAL C str_p: WORD GLOBAL C s_break: BYTE ; flag indicating shift-break key depressed GLOBAL C s_pc: WORD GLOBAL tickstat: BYTE GLOBAL C topofstack: WORD GLOBAL C t_attrib: WORD GLOBAL C ulcol: WORD GLOBAL C ulline: WORD GLOBAL C vidmode: WORD GLOBAL C vm_debug: WORD ; flag indicating VM debug mode GLOBAL C win_p: WORD ;************************************************************************ ;* Flags & macros * ;************************************************************************ ; Flags put in [show] for sprint SP_SEPARE = 01h SP_OUTPUT = 02h ; this special page value means we deal with an EMS page not currently loaded. EMSPAGE = 1 ; The LoadPage macros should be used to obtain the address of a given page ; from the pagetable. This must be done in order to access any given heap ; allocated object. For conventional memory, this just means indexing into ; the pagetable and accessing the paragraph address. MACRO ldpage dst, src:REST ; Get Page address from page table local @@notems IFDIF <src>, <bx> IFDIF <dst>, <bx> push bx ENDIF mov bx, src ENDIF cmp bl, [ss:emsbias] jb @@notems call loadems @@notems: mov dst, [ss:pagetable+bx] IFDIF <src>, <bx> IFDIF <dst>, <bx> pop bx ENDIF ENDIF ENDM ;************************************************************************ ;* Now follows the automatically produced code * ;************************************************************************ MACRO File args ENDM